load("clean_svybydemog_data.RData")
Gender equity in Louisville is an unfortunately unequal reality. Women are worse off in key standard of living areas such as household income and homeownership. Additionally, these issues are exasperated for women from a one-income home, women with children, and minority women. Disproportionate cost of living burdens and care-taking responsibilities can perpetuate a viscous cycle of inequity. Understanding the true size of the ‘equity gap’ can help inform policy decisions to stop this cycle from continuing.
Key definitions:
Key Takeaways:
Rolling mean explanation
Race categories explanation
GLP strives to use inclusive language and analyze data for traditionally underrepresented groups whenever possible. However, current data has its limitations. The terminology we use to describe race, sex, gender, and other identities mirrors the way questions were asked in the U.S. Census Bureau’s American Community Survey. Additionally, the survey does not provide us with enough information to create data on many populations in Louisville. When we break data down by race, we include data for white non-Hispanic residents, Black non-Hispanic residents, and Hispanic residents.
Gender:
> What is Person X’s sex? Mark (X) ONE box. > > [ ] Male > [
] Female
Race >Is Person X of Hispanic, Latino, or Spanish origin? > >[ ] No, not of Hispanic, Latino, or Spanish origin >[ ] Yes, Mexican, Mexican Am., Chicano >[ ] Yes, Puerto Rican >[ ] Yes, Cuban >[ ] Yes, another Hispanic, Latino, or Spanish origin – Print origin, for example, Argentinean, Colombian, Dominican, Nicaraguan, Salvadoran, Spaniard, and so on. –> ______________________________________
What is Person X’s race? Mark (X) one or more boxes.
[ ] White [ ] Black or African Am. [ ] American Indian or Alaska Native – Print name of enrolled or principal tribe. –> __________________ [ ] Asian Indian [ ] Japanese [ ] Native Hawaiian [ ] Chinese [ ] Korean [ ] Guamanian or Chamorro [ ] Filipino [ ] Vietnamese [ ] Samoan [ ] Other Asian – Print race, for example, Hmong, Laotian, Thai, Pakistani, Cambodian, and so on. –> _____________________ [ ] Other Pacific Islander – Print race, for example, Fijian, Tongan, and so on. –>______________________ [ ] Some other race – Print race. –> ____________________________________________________
Data are often scarce for Hispanic and Latinx populations, as well for the LGBTQ+ population. National data we collect–for measures such as overdoses and certificates–are often unavailable at the zip code or neighborhood levels.
Multiple-income households have much higher rates of homeownership than single-income households. There is little difference in homeownership between single-income men and women in Louisville.
temp_df <- H_earntype %>%
filter(race == 'total',
var_type == "percent", sex == "total") %>%
pivot_wider(names_from = "earner_type_d", values_from = "homeownership")
trend(temp_df,
multiple_earner:single_male_earner,
plot_title = "Homeownership by Gender",
cat = c("Multiple Earners" = "multiple_earner", "Single Female" = "single_fem_earner", "Single Male" = "single_male_earner"),
pctiles = F,
y_title = 'Percent',
rollmean = 3,
caption_text =
"Source: Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
For the rest of this section, we will focus on single-income females. Single-income women in Louisville have consistenly higher rates of homeownership than our peer cities.
temp_df <- H_earntype %>%
filter(earner_type_d == "single_fem_earner",
var_type == "percent", sex == "total") %>%
mutate(sex = "total")
ranking(temp_df,
'homeownership',
plot_title = "Single-Income Female Homeownership",
caption_text =
"Source: Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
Looking deeper at which women own homes, we see that single-income women without children have much higher rates of homeownership than those with children. While Louisville outperforms its peers among those without children, Louisville unederperforms compared to its peer among those with children.
H_s_Femkids_trend %<>%
filter(
var_type == 'percent',
race == 'total',
sex == "female") %>%
pivot_wider(names_from = 'kd_pres', values_from = 'homeownership') %>%
select(-sex)
trend(H_s_Femkids_trend,
kids:no_kids,
rollmean = 3,
plot_title = "Female Homeownership by Presence of Children",
cat = c("Children" = "kids", "No Children" = "no_kids"),
y_title = 'Percent',
caption_text =
"Source: Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
We see additional disparities by race. While single-income white women in Louisville have higher-than average rates of homeownership, single-income Black women have lower than average rates of homeownership. Data for Hispanic women is less consistent, but we have certainly seen an upward trend from 2010 to 2018.
temp_df <- H_earntype %>%
filter(earner_type_d == "single_fem_earner",
var_type == "percent", sex == "total")
trend(filter(temp_df, race != "hispanic"),
homeownership,
rollmean = 3,
pctiles = F,
plot_title = "Single Female Homeownership by Year",
cat = 'race',
y_title = 'Percent',
caption_text =
"Source Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
For single-income women without children, homeownership rates appear very similar to the patterns we see among the group overall.
df_no_kids_race <- census_microdata081122 %>%
group_by(FIPS, year, race, earner_type_d, kd_pres) %>%
summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop")
df_no_kids <- census_microdata081122 %>%
group_by(FIPS, year, earner_type_d, kd_pres) %>%
summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop") %>%
mutate(race = "total")
df_no_kids %<>%
bind_rows(df_no_kids_race) %>%
select(FIPS, year, race, earner_type_d, homeownership, kd_pres) %>%
filter(earner_type_d == "single_fem_earner",
kd_pres == "no_kids")
trend(filter(df_no_kids, race != "hispanic"),
homeownership,
rollmean = 3,
pctiles = F,
plot_title = "Single Female Homeownership by Year without Children",
cat = 'race',
y_title = 'Percent',
caption_text =
"Source Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
For single-income women with children, we see dramatic differences. Data are less consistent making it tougher to draw conclusions; however, we can see tell Black women with children are very unlikely to be homeowners. Hispanic women with children have made significant gains in homeownership in the last several year.
df_kids_race <- census_microdata081122 %>%
group_by(FIPS, year, race, earner_type_d, kd_pres) %>%
summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop")
df_kids <- census_microdata081122 %>%
group_by(FIPS, year, earner_type_d, kd_pres) %>%
summarize(homeownership = sum(HHWT[homeownership]) / sum(HHWT) * 100, .groups = "drop") %>%
mutate(race = "total")
df_kids %<>%
bind_rows(df_kids_race) %>%
select(FIPS, year, race, earner_type_d, homeownership, kd_pres) %>%
filter(earner_type_d == "single_fem_earner",
kd_pres == "kids")
trend(filter(df_kids, race != "hispanic"),
homeownership,
rollmean = 3,
pctiles = F,
plot_title = "Single Female Homeownership by Year with Children",
cat = 'race',
y_title = 'Percent',
caption_text =
"Source Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
Before we explore housing affordability, we will dive into wage disparities in Louisville by gender.
#fix formatting
single_earner_pctiles <- lville_2019 %>%
group_by(sex) %>%
summarize(
ten_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.1),
twenty_five_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.25),
fifty_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.5),
seventy_five_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.75),
ninety_pct = Hmisc::wtd.quantile(HHINCOME, HHWT, probs = 0.9))
library(gt)
gt(single_earner_pctiles) %>%
tab_header(title = "Income Percentiles by Sex",
subtitle = "") %>%
fmt_currency(columns = vars(ten_pct, twenty_five_pct, fifty_pct, seventy_five_pct,
ninety_pct),
use_subunits = F) %>%
cols_label(ten_pct = "10th",
twenty_five_pct = "25th",
fifty_pct = "Median",
seventy_five_pct = "75th",
ninety_pct = "90th") %>%
cols_align(align = "center") %>%
tab_source_note(
source_note = md("Source: ACS microdata from IPUMS-USA")) %>%
opt_row_striping(row_striping = TRUE) %>%
opt_table_outline() %>%
tab_options(
table.font.size = px(12),
table.width = pct(50)) %>%
tab_style(
cell_text(
font = "Montserrat",
weight = "bold"),
cells_row_groups())
| Income Percentiles by Sex | |||||
|---|---|---|---|---|---|
| sex | 10th | 25th | Median | 75th | 90th |
| female | $11,200 | $25,000 | $50,000 | $91,000 | $152,000 |
| male | $18,000 | $37,000 | $66,900 | $108,400 | $170,000 |
| Source: ACS microdata from IPUMS-USA | |||||
For single-adult households, a living wage is $33k for a single adult, $66k for an adult with one child, $84k for an adult with two children, and $112k for one adult and one child.
p <- lville_2019 %>%
filter(HHINCOME <= cut_95,
earner_type == "single_earner") %>%
func_plt_hist_overlay( "sex")
p <- p + glp_graph_theme
p <- p + labs(
title = "Single Earner Income by Gender",
) +
ylab(" ") +
guides(color = FALSE) +
facet_wrap(~sex, nrow = 2) +
theme(
#axis.ticks.x = element_line(size = 50000),
strip.text = element_blank()
) +
scale_x_continuous(
breaks = c(50000, 100000, 150000, 200000),
label = c("$50k", "$100k", "$150k", "$200k")
) +
scale_y_continuous(labels = scales::comma)
p
temp_df <- lville_2019 %>%
filter(HHINCOME <= cut_95,
earner_type == "single_earner")
p_percent <- ggplot(temp_df, aes(x=HHINCOME,
y = (..count..)/sum(..count..),
fill=sex,
color = sex,
weight = HHWT)) +
geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000) +
scale_fill_manual(values = c("#0E4A99", "#F58021", "#00A9B7")) +
scale_color_manual(values = c("#0E4A99", "#F58021", "#00A9B7")) +
labs(fill="") +
xlab("Household Income") +
ylab("Percentage")
p_percent <- p_percent + glp_graph_theme
p_percent <- p_percent + labs(
title = "Single Earner Income by Gender",
) +
ylab(" ") +
guides(color = FALSE) +
facet_wrap(~sex, nrow = 2) +
theme(
#axis.ticks.x = element_line(size = 50000),
strip.text = element_blank()
) +
scale_x_continuous(
breaks = c(50000, 100000, 150000, 200000),
label = c("$50k", "$100k", "$150k", "$200k")
) +
scale_y_continuous(labels=percent)
p_percent
##add original faceted graph
sing_fem_inc_race<-census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
earner_type == 'single_earner',
HHINCOME <= cut_95)
sing_fem_inc_race_plt <- sing_fem_inc_race %>%
ggplot( aes(x=HHINCOME,
y = (..count..)/sum(..count..),
fill=race,
color = race,
weight = HHWT)) +
geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000)
sing_fem_inc_race_plt <- sing_fem_inc_race_plt + facet_wrap(~race, nrow = 2)
sing_fem_inc_race_plt <- sing_fem_inc_race_plt + glp_graph_theme
sing_fem_inc_race_plt <- sing_fem_inc_race_plt +
labs(
title = "Female Single Earner Income",
) +
ylab(" ") +
xlab("Household Income")
# guides(color = FALSE)
sing_fem_inc_race_plt <- sing_fem_inc_race_plt +
theme(
#axis.ticks.x = element_line(size = 50000),
strip.text = element_blank()
) +
scale_x_continuous(
breaks = c(50000, 100000, 150000),
label = c("$50k", "$100k", "$150k")
) +
scale_y_continuous(labels = scales::percent)
sing_fem_inc_race_plt <- sing_fem_inc_race_plt +
scale_fill_manual(values = c("#0E4A99", "#F58021","#00A9B7", "#800055")) +
scale_color_manual(values = c("#0E4A99","#F58021","#00A9B7", "#800055"))
sing_fem_inc_race_plt
black_female_earner <- func_income_by_race("black")
black_female_earner
### Single Hispanic Female Earners
hisp_female_earner <- func_income_by_race("hispanic")
hisp_female_earner <- hisp_female_earner +
labs(
title = "Hispanic Female Single Earner Income",
) +
scale_fill_manual(values = "#0E4A99") +
scale_color_manual(values = "#0E4A99")
hisp_female_earner
white_female_earner <- func_income_by_race("white")
white_female_earner <- white_female_earner +
labs(
title = "White Female Single Earner Income",
) +
scale_fill_manual(values = "#F58021") +
scale_color_manual(values = "#F58021")
white_female_earner
other_female_earner <- func_income_by_race("other")
other_female_earner <- other_female_earner +
labs(
title = "Other Female Single Earner Income",
) +
scale_fill_manual(values = "#00A9B7") +
scale_color_manual(values = "#00A9B7")
other_female_earner
func_income_by_kids <- function(num_kids, living_wage) {
w <- census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
NCHILD == num_kids,
earner_type == 'single_earner',
HHINCOME <= cut_95)
w <- w %>%
ggplot( aes(x=HHINCOME,
y = (..count..)/sum(..count..),
fill = sex,
group = sex,
weight = HHWT)) +
geom_histogram(alpha=0.5, position = 'identity', binwidth = 10000) +
geom_vline( aes(xintercept = living_wage), linetype = "dashed", colour="blue", size = 1.5)
#sing_fem_inc_race_plt <- sing_fem_inc_race_plt + facet_wrap(~race, nrow = 2)
w <- w + glp_graph_theme
w <- w +
labs(
title = "Black Female Single Earner Income",
) +
ylab(" ") +
xlab("Household Income")+
guides(color = FALSE)
w <- w +
theme(
#axis.ticks.x = element_line(size = 50000),
strip.text = element_blank()
) +
scale_x_continuous(
breaks = c(50000, 100000, 150000),
label = c("$50k", "$100k", "$150k")
) +
scale_y_continuous(labels = scales::percent)
return (w)
}
#why is color not working?
#still need to add living wage lines
under_liv_wage_0 <- census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
NCHILD == 0,
earner_type == 'single_earner') %>%
group_by(HHINCOME < 33321.6) %>%
summarize(count = sum(HHWT)) #a little more than half are earning a living wage
#do this for each graphof this type...add info above chunk
no_kids_female_earner <- func_income_by_kids(0, 33321.6)
no_kids_female_earner <- no_kids_female_earner +
labs(
title = "Female Single Earner Income, No Children",
) +
scale_fill_discrete(labels = "No Children")
no_kids_female_earner
under_liv_wage_1 <- census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
NCHILD == 1,
earner_type == 'single_earner') %>%
group_by(HHINCOME < 66081.6) %>%
summarize(count = sum(HHWT))
one_child <- func_income_by_kids(1, 66081.6)
one_child <- one_child +
labs(
title = "Female Single Earner Income, One Child",
) +
scale_fill_manual(values = "#800055", labels = "One Child" ) +
scale_color_manual(values = "#800055")
one_child
under_liv_wage_2 <- census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
NCHILD == 2,
earner_type == 'single_earner') %>%
group_by(HHINCOME < 83990.4) %>%
summarize(count = sum(HHWT))
two_child <- func_income_by_kids(2, 83990.4)
two_child <- two_child +
labs(
title = "Female Single Earner Income, Two Children",
) +
scale_fill_manual(values = "#356E39", labels = "Two Children") +
scale_color_manual(values = "#356E39")
two_child
under_liv_wage_3 <- census_microdata081122 %>%
filter(
FIPS == "21111",
year %in% 2016:2019,
sex == 'female',
NCHILD == 3,
earner_type == 'single_earner') %>%
group_by(HHINCOME < 111529.6) %>%
summarize(count = sum(HHWT))
three_child <- func_income_by_kids(3, 111529.6)
three_child <- three_child +
labs(
title = "Female Single Earner Income With Three Children",
) +
scale_fill_manual(values = "#CFB94C", labels = "Three Children") +
scale_color_manual(values = "#CFB94C")
three_child
these_labels <- paste0(dollar(seq(1, 273500, 10000), scale = 0.001, accuracy = 1, suffix = "k"))
cost_burden_sf <- lville_2019 %>%
filter(
sex == 'female',
earner_type == 'single_earner',
HHINCOME <= cut_95) %>%
mutate(
cost_burden = factor(cost_burden,
levels = rev(c(TRUE, FALSE)),
labels = rev(c("Cost Burdened", "Non Cost Burdened")),
ordered = TRUE),
inc_bins = cut(HHINCOME, seq(1, 283500, 10000),
labels = these_labels) %>%
factor(levels = these_labels, ordered = TRUE)
)
temp_df <- cost_burden_sf %>%
group_by(inc_bins, cost_burden) %>%
summarize(count = sum(HHWT), .groups = "drop") %>%
complete(inc_bins, cost_burden, fill = list(count = 0)) %>%
filter(!is.na(inc_bins)) %>%
group_by(inc_bins) %>%
mutate(percent = count / sum(count)) %>%
ungroup() %>%
filter(cost_burden == "Cost Burdened")
temp_df <- temp_df[1:14,]
cost_burden_sf_plot <- ggplot(temp_df,
aes(x = inc_bins,
y = percent,
group = 1)) +
geom_line(linetype = "dotted", color="purple", size=3) +
geom_point(color="purple", size=8)
cost_burden_sf_plot <- cost_burden_sf_plot + glp_graph_theme
cost_burden_sf_plot <- cost_burden_sf_plot +
labs(
title = "Female Single Earner Cost Burden Level by Income",
) +
ylab(" ") +
xlab("Household Income") +
guides(color = FALSE) +
theme(
strip.text = element_blank()
) +
scale_color_manual(values = c("#0E4A99")) +
scale_y_continuous(labels = scales::percent)
cost_burden_sf_plot
#I_CB_earn_trend <- survey_by_demog(census_microdata081122, weight_var = "HHWT", 'cost_burden', other_grouping_vars = c('earner_type'), breakdowns = "sex")
# I_CB_earn_trend <- survey_by_demog(census_microdata081122, weight_var = "HHWT", 'cost_burden', other_grouping_vars = c('earner_type_d'))
I_CB_earn_trend %<>%
filter(
var_type == 'percent',
race == 'total',
sex == 'total') %>%
select( -c(sex,race)) %>%
pivot_wider(names_from = "earner_type_d", values_from = "cost_burden")
trend(I_CB_earn_trend,
multiple_earner:single_fem_earner:single_male_earner,
pctiles = F,
plot_title = "Cost Burden by Earner Type",
cat = c("Multiple Earners" = "multiple_earner", "Single Female Earner" = "single_fem_earner", "Single Male Earner" = "single_male_earner"),
y_title = 'Percent',
caption_text =
"Source Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")
I_median_earn_age <- lville_2019 %>%
group_by(age_group, earner_type_d) %>%
summarize(Med=median(HHINCOME))
I_median_earn_age_plot <- ggplot(I_median_earn_age,
aes(x=age_group, y=Med, fill = earner_type_d)) +
geom_bar(stat="identity", position='dodge')
I_median_earn_age_plot <- I_median_earn_age_plot + glp_graph_theme
I_median_earn_age_plot <- I_median_earn_age_plot +
labs(
title = "Median Earnings by Age Group",
) +
ylab("Household Income") +
xlab("Age Group") +
scale_y_continuous(labels = scales::dollar) +
scale_fill_manual(
values = c("#0E4A99", "#F58021", "#00A9B7"),
labels = c("Multiple Earner", "Single Female Earner", "Single Male Earner"))
I_median_earn_age_plot
E_singM_singF <- census_microdata081122 %>%
filter(year %in% 2017:2019,
earner_type == 'single_earner') %>%
group_by(sex, educ, kd_pres) %>%
summarize(n=sum(HHWT, na.rm = TRUE)) %>%
mutate(
total = sum(n),
rate = n/sum(n)*100,
educ = factor(educ,
levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")),
ordered = TRUE))
E_singM_singF_plot <- ggplot(E_singM_singF,
aes(x=sex,
y=rate,
fill = educ)) +
geom_bar(stat="identity", position = "fill")
E_singM_singF_plot <- E_singM_singF_plot + facet_wrap(~kd_pres)
E_singM_singF_plot <- E_singM_singF_plot + glp_graph_theme
E_singM_singF_plot <- E_singM_singF_plot +
theme(
legend.position = "right"
) +
labs(
title = "Single Earner Education Levels by Gender",
) +
ylab(" ") +
xlab(" ") +
scale_fill_discrete(
labels = c("Graduate","Bachelor", "Associate", "Some College", "High School", "No High School")) +
scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
scale_y_continuous(labels = scales::percent)
E_singM_singF_plot
E_singF_race <- lville_2019 %>%
filter(
sex == 'female',
earner_type == 'single_earner') %>%
group_by(race, educ) %>%
summarize(n=sum(HHWT, na.rm = TRUE)) %>%
mutate(
total = sum(n),
rate = n/sum(n)*100,
educ = factor(educ,
levels = rev(c("no_hs", "hs", "some_col", "assoc", "bach","grad")),
ordered = TRUE))
E_singF_race_plot <- ggplot(E_singF_race, aes(x=race, y=rate, fill=educ)) +
geom_bar(stat="identity", position='fill')
E_singF_race_plot <- E_singF_race_plot + glp_graph_theme
E_singF_race_plot <- E_singF_race_plot +
theme(
legend.position = "right"
) +
labs(
title = "Single Female Education Breakdown",
) +
ylab(" ") +
xlab("Race") +
scale_fill_discrete(labels = c("Graduate","Bachelor", "Associate", "Some College", "High School", "No High School")) +
scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
scale_y_continuous(labels = scales::percent)
E_singF_race_plot
cost_burden_age_sf %<>% drop_na(cost_burden) #this will need to be run once and then left alone if tweaking graphs
cost_burden_age_sf_plot <- ggplot(cost_burden_age_sf,
aes(x=age_group, y=HHWT , fill=cost_burden),
color="#00A9B7") +
geom_bar(stat="identity", position='fill')
cost_burden_age_sf_plot <- cost_burden_age_sf_plot + glp_graph_theme
cost_burden_age_sf_plot <- cost_burden_age_sf_plot +
theme(
legend.position = "right"
) +
labs(
title = "Cost Burdened Status by Age",
) +
ylab(" ") +
xlab("Race") +
scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) +
#scale_x_discrete (labels = c("female" = "Female", "male" = "Male")) +
scale_y_continuous(labels = scales::percent)
cost_burden_age_sf_plot
temp_df1 <- cost_burden_age_sf %>%
filter(earner_type_d == "single_fem_earner") %>%
mutate(
age_group = case_when(
age %in% 15:19 ~ NA_character_,
age %in% 20:29 ~ "20-29",
age %in% 30:39 ~ "30-39",
age %in% 40:49 ~ "40-49",
age %in% 50:59 ~ "50-59",
age %in% 60:69 ~ "60-69",
age %in% 70:79 ~ "70-79",
age >= 80 ~ "80+"))
temp_df1 %<>% filter(!is.na(age_group))
cost_burden_age_sf_facet_plt <- ggplot(temp_df1,
aes(x=age_group, y=HHWT , fill=cost_burden),
color="#00A9B7") +
geom_bar(stat="identity", position='fill')
#facet_wrap(~earner_type_d)
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + glp_graph_theme
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt +
theme(
legend.position = "right",
strip.text = element_text(size = 40)
) +
labs(
title = "Cost Burdened Status by Age and Earner Type",
) +
ylab(" ") +
xlab(" ") +
scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) +
scale_x_discrete(guide = guide_axis(n.dodge=2)) +
scale_y_continuous(labels = scales::percent)
cost_burden_age_sf_facet_plt
### Male Single Earner
temp_df2 <- cost_burden_age_sf %>%
filter(earner_type_d == "single_male_earner") %>%
mutate(
age_group = case_when(
age %in% 15:19 ~ NA_character_,
age %in% 20:29 ~ "20-29",
age %in% 30:39 ~ "30-39",
age %in% 40:49 ~ "40-49",
age %in% 50:59 ~ "50-59",
age %in% 60:69 ~ "60-69",
age %in% 70:79 ~ "70-79",
age >= 80 ~ "80+"))
temp_df2 %<>% filter(!is.na(age_group))
cost_burden_age_sf_facet_plt <- ggplot(temp_df2,
aes(x=age_group, y=HHWT , fill=cost_burden),
color="#00A9B7") +
geom_bar(stat="identity", position='fill')
#facet_wrap(~earner_type_d)
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + glp_graph_theme
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt +
theme(
legend.position = "right",
strip.text = element_text(size = 40)
) +
labs(
title = "Cost Burdened Status by Age and Earner Type",
) +
ylab(" ") +
xlab(" ") +
scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) +
scale_x_discrete(guide = guide_axis(n.dodge=2)) +
scale_y_continuous(labels = scales::percent)
cost_burden_age_sf_facet_plt
temp_df3 <- cost_burden_age_sf %>%
filter(earner_type_d == "multiple_earner") %>%
mutate(
age_group = case_when(
age %in% 15:19 ~ NA_character_,
age %in% 20:29 ~ "20-29",
age %in% 30:39 ~ "30-39",
age %in% 40:49 ~ "40-49",
age %in% 50:59 ~ "50-59",
age %in% 60:69 ~ "60-69",
age %in% 70:79 ~ "70-79",
age >= 80 ~ "80"))
temp_df3 %<>% filter(!is.na(age_group))
cost_burden_age_sf_facet_plt <- ggplot(temp_df3,
aes(x=age_group, y=HHWT , fill=cost_burden),
color="#00A9B7") +
geom_bar(stat="identity", position='fill')
#facet_wrap(~earner_type_d)
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt + glp_graph_theme
cost_burden_age_sf_facet_plt <- cost_burden_age_sf_facet_plt +
theme(
legend.position = "right",
strip.text = element_text(size = 40)
) +
labs(
title = "Cost Burdened Status by Age and Earner Type",
) +
ylab(" ") +
xlab(" ") +
scale_fill_discrete(labels = c("Non Cost Burdened", "Cost Burdened")) +
scale_x_discrete(guide = guide_axis(n.dodge=2)) +
scale_y_continuous(labels = scales::percent)
cost_burden_age_sf_facet_plt
earner_trend <- census_microdata081122 %>%
mutate(
earner_type_d = case_when(
sex == 'female' & earner_type == 'single_earner' ~ 'single_fem_earner',
sex == 'male' & earner_type == 'single_earner' ~ 'single_male_earner',
earner_type == 'multi_earner' ~ 'multiple_earner')
) %>%
group_by(year, earner_type_d) %>%
summarize(n=sum(HHWT, na.rm = TRUE)) %>%
mutate(
total = sum(n),
rate = n/sum(n)*100)
earner_trend_plt <- ggplot(earner_trend,
aes(x=year, y=rate, fill=earner_type_d),
color="#00A9B7") +
geom_bar(stat="identity", position='fill')
earner_trend_plt <- earner_trend_plt + glp_graph_theme
earner_trend_plt <- earner_trend_plt +
theme(
legend.position = "right"
#strip.text = element_blank()
) +
labs(
title = "Earner Type Trend"
) +
ylab(" ") +
xlab(" ") +
scale_fill_discrete(labels = c("Multiple Earner", "Single Female Earner", "Single Male Earner")) +
scale_y_continuous(labels = scales::percent)
earner_trend_plt
ranking(H_sinFem_kids,
'homeownership',
plot_title = "Single Earner Female Homeownership with Children",
#title_scale = 0.8,
caption_text =
"Source: Greater Louisville Project
Data from GLP analysis of ACS microdata from IPUMS-USA")